home *** CD-ROM | disk | FTP | other *** search
Modula Implementation | 1995-11-25 | 4.9 KB | 211 lines |
- IMPLEMENTATION MODULE PreisListe;
-
- FROM SYSTEM IMPORT TSIZE;
- FROM Storage IMPORT ALLOCATE,DEALLOCATE;
-
- TYPE PriceList = POINTER TO PriceListHeader;
- PriceListElementPointer = POINTER TO PriceListElement;
- PriceListHeader = RECORD
- current,
- first,last : PriceListElementPointer;
- END ;
- PriceListElement = RECORD
- next,prev : PriceListElementPointer;
- value : EKPreis
- END(*RECORD*);
-
- PROCEDURE MakePriceList(VAR L:PriceList);
- BEGIN
- ALLOCATE(L,TSIZE(PriceListHeader));
- L^.first:=NIL;
- L^.last:=NIL;
- L^.current:=NIL;
- END MakePriceList;
-
- PROCEDURE KillPriceList(VAR L:PriceList);
- VAR p,q:PriceListElementPointer;
- BEGIN
- p:=L^.first;
- WHILE (p#NIL) DO
- q:=p;
- p:=p^.next;
- DEALLOCATE(q);
- END(*WHILE*);
- DEALLOCATE(L);
- L:=NIL
- END KillPriceList;
-
- PROCEDURE First(VAR L:PriceList);
- BEGIN
- L^.current:=L^.first;
- END First;
-
- PROCEDURE Last(VAR L:PriceList);
- BEGIN
- L^.current:=L^.last;
- END Last;
-
- PROCEDURE Next(VAR L:PriceList);
- BEGIN
- IF (~Empty(L) AND (L^.current^.next # NIL))THEN
- L^.current:=L^.current^.next;
- END(*IF*);
- END Next;
-
- PROCEDURE Prev(VAR L:PriceList);
- BEGIN
- IF (~Empty(L) AND (L^.current^.prev # NIL))THEN
- L^.current:=L^.current^.prev;
- END(*IF*);
- END Prev;
-
- PROCEDURE Empty(VAR L:PriceList):BOOLEAN;
- BEGIN
- RETURN L^.first=NIL
- END Empty;
-
- PROCEDURE AtFirst(VAR L:PriceList):BOOLEAN;
- BEGIN
- RETURN L^.current=L^.first
- END AtFirst;
-
- PROCEDURE AtLast(VAR L:PriceList):BOOLEAN;
- BEGIN
- RETURN L^.current=L^.last
- END AtLast;
-
- PROCEDURE Find(VAR L:PriceList;VAR Value:EKPreis; VAR Finde:FindProc; Key:EKPreis ):BOOLEAN;
- VAR OK :BOOLEAN;
- BEGIN
- IF ~Empty(L) THEN
- LOOP
- OK:=GetValue(L,Value);
- IF Finde(Value,Key) THEN
- RETURN TRUE
- ELSE
- IF AtLast(L) THEN
- RETURN FALSE
- END(*IF*);
- Next(L);
- END(*IF*);
- END(*LOOP*);
- ELSE
- RETURN FALSE
- END(*IF*);
- END Find;
-
- PROCEDURE FindFirst(VAR L:PriceList;VAR Value:EKPreis; VAR Finde:FindProc; Key:EKPreis):BOOLEAN;
- BEGIN
- IF ~Empty(L) THEN
- First(L);
- RETURN Find(L,Value,Finde,Key);
- ELSE
- RETURN FALSE
- END(*IF*);
- END FindFirst;
-
- PROCEDURE FindNext(VAR L:PriceList;VAR Value:EKPreis; VAR Finde:FindProc;Key:EKPreis):BOOLEAN;
- BEGIN
- IF ~Empty(L) THEN
- Next(L);
- RETURN Find(L,Value,Finde,Key);
- ELSE
- RETURN FALSE
- END(*IF*);
- END FindNext;
-
-
- PROCEDURE GetValue(VAR L:PriceList;VAR Value :EKPreis):BOOLEAN;
- VAR i:INTEGER;
- BEGIN
- IF ~Empty(L) THEN
- Value:=L^.current^.value;
- RETURN TRUE
- ELSE
- RETURN FALSE
- END(*IF*);
- END GetValue;
-
- PROCEDURE SetValue(VAR L:PriceList;Value :EKPreis);
- VAR i:INTEGER;
- BEGIN
- IF ~Empty(L) THEN
- L^.current^.value:=Value;
- END(*IF*);
- END SetValue;
-
- PROCEDURE EnterElement(VAR L:PriceList);
- VAR p,q :PriceListElementPointer;
- BEGIN
- ALLOCATE(p,TSIZE(PriceListElement));
- IF Empty(L) THEN
- L^.first:=p;
- L^.last:=p;
- p^.next:=NIL;
- p^.prev:=NIL;
- ELSIF AtFirst(L) THEN
- p^.next:=L^.first;
- L^.first:=p;
- p^.prev:=NIL;
- L^.current^.prev:=p;
- ELSE
- p^.next:=L^.current;
- p^.prev:=L^.current^.prev;
- q:=L^.current^.prev;
- q^.next:=p;
- L^.current^.prev:=p;
- END(*IF*);
- L^.current:=p;
- END EnterElement;
-
- PROCEDURE AppendElement(VAR L:PriceList);
- VAR p,q :PriceListElementPointer;
- BEGIN
- ALLOCATE(p,TSIZE(PriceListElement));
- IF Empty(L) THEN
- L^.first:=p;
- L^.last:=p;
- p^.next:=NIL;
- p^.prev:=NIL;
- ELSIF AtLast(L) THEN
- p^.prev:=L^.last;
- L^.last:=p;
- p^.next:=NIL;
- L^.current^.next:=p;
- ELSE
- p^.next:=L^.current^.next;
- p^.prev:=L^.current;
- q:=L^.current^.next;
- q^.prev:=p;
- L^.current^.next:=p;
- END(*IF*);
- L^.current:=p;
- END AppendElement;
-
- PROCEDURE RemoveElement(VAR L:PriceList);
- VAR p,q :PriceListElementPointer;
- BEGIN
- IF ~Empty(L) THEN
- p:=L^.current;
- IF (AtFirst(L) AND AtLast(L)) THEN
- L^.first:=NIL;
- L^.last:=NIL;
- L^.current:=NIL;
- ELSIF AtFirst(L) THEN
- L^.first:=L^.current^.next;
- L^.first^.prev:=NIL;
- L^.current:=L^.current^.next;
- ELSIF AtLast(L) THEN
- L^.last:=L^.current^.prev;
- L^.last^.next:=NIL;
- L^.current:=L^.current^.prev;
- ELSE
- p^.prev^.next:=p^.next;
- p^.next^.prev:=p^.prev;
- L^.current:=L^.current^.next;
- END(*IF*);
- DEALLOCATE(p);
- END(*IF*);
- END RemoveElement;
- END PreisListe.
-